#
# Routines to send email on behalf of the Linux Counter
#
package Counter::Sendemail;

use strict;
use Counter;
use MD5Cookies;
use Socket;
use POSIX qw(strftime uname);

use vars qw($test $shortfrom $DEBUG);

$test = 0;
$shortfrom = "errors\@counter.li.org";


sub test {
    my $newval = shift;
    if (defined($newval)) {
	my $retval = $test;
	$test = $newval;
	return $retval;
    } else {
	return $test;
    }
}

sub sendemail {

    my $key = shift;
    my $message = shift;
    my $users = Counter::openfile("users");
    my $user = $users->get($key);

# Create a from addr that includes the record. Nice for bounce processing
    my $fromaddr = "errors+$key\@counter.li.org";

    if (!$user) {
	die "No user record for key $key\n";
    }
    if ($user->{state} eq "blocked") {
	die "User $key is in blocked state\n";
    }


    my $language = $user->language();
    $DEBUG && warn "Language is $language\n";
    # Find if we have language specific file
    my $msgdir = Counter::root() . "/i18n/email";
    $DEBUG && warn "Msgdir is $msgdir\n";

    if (!$message) {

	if ($user->{state} ne "frozen") {
	    if ( -f "$msgdir/entry.$language.txt") {
		$message = readfile("$msgdir/entry.$language.txt");
		if ($language ne "en") {
		    $message .= "\n\n------- English ---------\n";
		}
	    }
	    $message .= readfile("$msgdir/entry.en.txt");
	} else {
	    if ( -f "$msgdir/entry.$language.txt") {
		$message = readfile("$msgdir/frozen.$language.txt");
		if ($language ne "en") {
		    $message .= "\n\n------- English ---------\n";
		}
	    }
	    $message .= readfile("$msgdir/frozen.en.txt");
	}	    
    }

# Create the identification id for the renew url in the email
my $id = MD5Cookies::tsign($key, $$user{key}, 7*24*60*60);
# warn "output: $id";

# Put data from user record into message
    $message =~ s/\$key\b/$key/g;
    $message =~ s/\$password\b/$$user{key}/g;
    $message =~ s/\$identification\b/$id/g;

# Get the addresses to send to. Command line overrides record.
    my @sendto;
    while (my $addr = shift) {
	push(@sendto, detaintaddr($addr));
    } 
    if (!defined($sendto[0])) {
	$sendto[0] = detaintaddr($user->{email});
    }

# Detaint from, "just in case"
    $fromaddr = detaintaddr($fromaddr);

# Check if I am the Linux Counter
    if (!$test && !isrealcounter()) {
	warn "I am not the Linux Counter - not sending mail for $key to ",
	join(" ", @sendto), "\n";
	if (-t STDERR) {
	    warn "Switching into test mode\n";
	    $test = 1;
	} else {
	    return;
	}
    }

    my $sendto = quoteshellmeta(join(" ", @sendto));
    if ($test) {
	warn "Starting to send mail\n";
	open(MAIL, ">&", "STDOUT");
	print "CMD: |/usr/lib/sendmail -f$fromaddr -- ", $sendto, "\n";
    } else {
	# note redirect of stdout of sendmail to stderr = error log file
	open(MAIL, "|/usr/lib/sendmail -f$fromaddr -- $sendto > /dev/null 1>&2");
    }

# If sendto is multiple addresses, take care

    $sendto = join(", ", @sendto);

    $] > 5.008 && binmode(MAIL, ":utf8");


    print MAIL <<EoF;
From: Linux Counter <$shortfrom>
To: $sendto
Subject: Your entry in the Linux Counter
MIME-Version: 1.0
Content-type: text/plain; charset=utf-8


$message

All comments: help\@counter.li.org

EoF


    my $persons = Counter::openfile("persons");
    my $person = $persons->get($key);

    print MAIL "Your record was created:   $$user{f_ctime}\n";
    if ($person) {
	print MAIL "Person info last modified: $$person{f_mtime}\n";
    }
    print MAIL "\n";

    print MAIL "//KEY ", $user->{key}, "\n";
    print MAIL "# The key is your password to update info in the counter\n";

    print MAIL "//REPLYTO ", $user->{email}, "\n";
    print MAIL "# Your registered email for messages from the counter", "\n";
    print MAIL "# This email is NOT visible to other people\n";

    if ($person) {
	print MAIL "\n//PERSON\n";
	my $clean = $persons->getclean($key);
	for my $field ($persons->fields) {
	    emitfield($person, $clean, $field);
	    # Not sure about this - it makes noise.
	    #if ($person->validator->help($field)) {
	    #    print MAIL "# ", $person->validator->help($field), "\n";
	    #}
	}
    }
    my $machines = Counter::openfile("machines");
    for my $machine ($machines->select("owner=?", $key)) {
	my $clean = $machines->getclean($machine->key);
	print MAIL "\n//MACHINE ", $machine->key, "\n";
	for my $field ($machines->fields) {
	    emitfield($machine, $clean, $field);
	}
    }
    close MAIL;
    $user->{emailtime} = strftime "%Y-%m-%d %H:%M:%S", gmtime();
    $user->store() if !$test;

}

sub emitfield {
    my ($rec, $clean, $field) = @_;
    print MAIL "$field: ", $rec->{$field}, "\n";
    if ("\L$clean->{$field}" ne "\L$rec->{$field}") {
	if ($clean->{$field} !~ /^\s*$/) {
	    print MAIL "# Interpreted as ", $clean->{$field}, "\n";
	} else {
	    print MAIL "# Interpreted as empty field (comment)\n";
	}
    }
}

# This will do until a better hack comes along....
sub isrealcounter {
    my $counter = gethostbyname("counter.li.org");
    my ($sys, $node, $rel, $ver, $mach) = uname();
    my $me = gethostbyname($node);
    die "Bad me" if length($me) < 4;
    die "Bad counter" if length($counter) < 4;
    if ($me ne $counter) {
	warn "I am ", inet_ntoa($me), ", not ", inet_ntoa($counter), "\n";
	return 0;
    } else {
	return 1;
    }
}

# Guardian routine against obvious problems with command-line args
sub detaintaddr {
    my $addr = shift;

    # Strip spaces
    $addr =~ s/^\s+//;
    $addr =~ s/\s+$//;
    # Check for user@host format
    if ($addr =~ /^(\S+)\@(\S+)$/) {
	$addr = "$1\@$2";
    } elsif  ($addr =~ /^"([^" ]+) ([^" ]+")@\S+/) {
	# allow a single quoted space in an address 
	warn "Quoted address: $addr\n";
	$addr = "$&";
    } else {
	die "Bogus shape of addr: $addr\n";
    }
    # Scan for shell metacharacters, or leading dash (sendmail option)
    # leading dash defeated by adding -- to sendmail command line.
    if ($addr =~ /[|;*?\(\)]/) {
	# be conservative - allow as needed
	# at the moment, asterisk is allowed
	if ($addr =~ /[|;?\(\)]/ || $addr =~ /^-/) {
	    die "Bogus char in addr: $addr\n";
	} else {
	    warn "Shell metachar in addr - to be quoted: $addr\n";
	}
    }
    $addr;
}

sub quoteshellmeta {
    my $addr = shift;
    my $oldaddr = $addr;
    $addr =~ s/[|;*?\(\)']/\\$&/g; # ';
    # allow a single quoted space in an address 
    $addr =~ s/"([^" ]+) ([^" ]+)"@/\\"$1\\ $2\\"@/; #";
    if ($oldaddr ne $addr) {
	warn "Quoted shell argument to $addr\n";
    }
    $addr;
}

sub readfile {
    my $filename = shift;

    $DEBUG && warn "Reading $filename\n";
    open(MSG, $filename) || die "Unable to open file $filename\n";
    local $/;
    my $content = <MSG>;
    close MSG;
    return $content;
}
